home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / graphics / scrfe100.zip / FONTOOLS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-27  |  8KB  |  294 lines
  1. UNIT Fontools;
  2. {$F+,O+,D+,R-,S-,V+,E-,N-}
  3.  
  4. {This Turbo Pascal unit is (C) Copyright 1993, Jeremy Lilley. The author
  5. (Jeremy Lilley) is not responsible for any problems with this unit or
  6. Screen Font Editor and modifying this file may have unpredictable and/or
  7. malevolent results}
  8.  
  9. interface
  10.  
  11. CONST
  12.   vseg : WORD = $b800;    {segment for video activity}
  13.   linesperchar : BYTE = 13;
  14.   VGA : BOOLEAN = FALSE;
  15.   EGA : BOOLEAN = FALSE;{VGA and EGA are set but detEGA at the init.}
  16. TYPE
  17.   fontsavetype = array [0..8191] of byte;{for saving the fonts}
  18.  
  19. {Of the following procedures, you will probably only use readfont
  20. and readscreen. The others are here for advanced programmers to
  21. use. Changing this file MAY HAVE UNPREDICTABLE RESULTS which may
  22. destroy a monitor if improperly done. Do not try to modify thes procedures!
  23. Proper detection is done and though the author makes no warranties,
  24. expressed or implied, there should be no problems when run as is.}
  25.  
  26. PROCEDURE readfont (bufptr:pointer);
  27. (* Use this to load a font to memory in the form of a disk file or memory
  28. image. Get the .SFF font file, run BINOBJ on it:
  29.                                    Name for pseudo-procedure
  30.                                     \
  31.  BINOBJ Fontfile.SFF Fontfile.OBJ Fontdata
  32.  
  33. You will have an OBJ file, and you must make it into a procedure and
  34. link it like this:
  35.  
  36. Program Fontdemo;
  37. uses fontools;
  38.  
  39. {$L Fontfile.OBJ}
  40. procedure Fontdata;EXTERNAL;  {Name specified above in BINOBJ}
  41.  
  42. begin
  43. readfont(@Fontdata);{MUST use "@"}
  44. end.
  45. *)
  46.  
  47. PROCEDURE readscreen (bufptr:pointer);
  48. (* This procedure is similar to the above except that you use it to load
  49. a screen or part of one. Get the .SFS screen file, run BINOBJ on it:
  50.                                    Name for pseudo-procedure
  51.                                     \
  52.  BINOBJ Scrfile.SFF Scrfile.OBJ ScreenData
  53.  
  54. You will have an OBJ file, and you must make it into a procedure and
  55. link it like this:
  56.  
  57. Program Scrdemo;
  58. uses fontools;
  59.  
  60. {$L Scrfile.OBJ}
  61. procedure Screendata;EXTERNAL;  {Name specified above in BINOBJ}
  62.  
  63. begin
  64. readscreen(@Screendata);{MUST use "@"}
  65. end.
  66. *)
  67. procedure resetfonts;
  68.  { This procedure will reset the screen for the default fonts, point size,
  69.  and number of scanlines to the system default without clearing the screen.}
  70. procedure savefonts (var buffer:fontsavetype);
  71.  { This procedure saves the currentfonts to a variable of fontsavetype type,
  72.  but not point sizes or scan lines}
  73. procedure restorefonts (var buffer:fontsavetype);
  74.  { This procedure retrieves the fonts from a variable of fontsavetype type,
  75.    but not the point sizes or scanlines}
  76. PROCEDURE sequencefonts;
  77.   { Sequences controllers so that you can change the fonts by just
  78.   moving bit-patterns into segment $A000. Each character occupies
  79.   32 bytes, but you will probably not want to use 32-point characters.
  80.   To change 1 character "c" if the bit-patterns are at "bit_pat," you
  81.   would need to sequence fonts, MOVE(bit_pat,mem[$A000:0],pointsperchar);
  82.   and desequence fonts.}
  83. PROCEDURE desequencefonts;{Do this after you are done moving things after
  84.    sequence fonts. MAKE SURE TO USE THUS IF YOU USE SEQUENCEFONTS!!!}
  85. PROCEDURE setscanlines (n : BYTE);{ Sets the scanlines on a VGA monitor
  86.   where n= 0 : 200 lines, 1 : 350 lines, 2 : 400 lines}
  87. PROCEDURE setlinesperchar;
  88.   {sets the number of points per line when linesperchar is equal to the
  89.    number of points MINUS 1, i.e. linesperchar=13 makes 14-point characters}
  90. PROCEDURE detEGA ;
  91.   {This procedure, called at the beginning of the program, sets the VGA
  92.    and EGA variables which allow or disallow various procedures from being
  93.    used. It usually need never be called by a programmer.}
  94. implementation
  95.  
  96. USES dos;
  97.  
  98. const
  99.   fontheader = '@JLSFF' + #1;
  100. type
  101.   fontheadertype = STRING [7];
  102. VAR
  103.   fontheaderstring : fontheadertype;
  104.  
  105. PROCEDURE sequencefonts;
  106. BEGIN
  107. if ega then begin
  108.   portw [$3c4] := $704;
  109.   portw [$3ce] := $204;
  110.   portw [$3ce] := 5;
  111.   portw [$3ce] := $406;
  112.   portw [$3c4] := $402;
  113.  end;
  114. END;
  115.  
  116. PROCEDURE desequencefonts;
  117. BEGIN
  118. if EGA then begin
  119.   portw [$3c4] := $302;
  120.   portw [$3c4] := $304;
  121.   portw [$3ce] := 4;
  122.   portw [$3ce] := $1005;
  123.   IF vseg = $b800 THEN
  124.      portw [$3ce] := $e06 ELSE
  125.      portw [$3ce] := $606
  126.   end;
  127. END;
  128.  
  129. PROCEDURE setscanlines (n : BYTE);
  130. VAR
  131.   sst : ARRAY [0..3999] OF
  132.   CHAR;
  133.   r : REGISTERS;
  134. BEGIN
  135.   MOVE (mem [vseg : 0], sst, 4000);
  136.   IF (n < 3)and(vga) THEN BEGIN
  137.      r.ax := $1200 + n;
  138.      r.bx := $30;
  139.      INTR ($10, r);
  140.      r.ax := $83;
  141.      IF vseg = $b000 THEN r.ax := $87;
  142.      INTR ($10, r);
  143.      r.cx := $c0d;
  144.      IF n = 0 THEN r.cx := $708;
  145.      r.ax := $100;
  146.      INTR ($10, r);
  147.      end;
  148.   MOVE (sst, mem [vseg : 0], 4000);
  149. END;
  150.  
  151.  
  152. PROCEDURE setlinesperchar;
  153. VAR
  154.   r : REGISTERS;
  155. BEGIN
  156. if ega then begin
  157.   r.ax := $1100;
  158.   r.bx := (linesperchar * 256);
  159.   r.cx := 0;
  160.   r.dx := 0;
  161.   INTR ($10, r);
  162.  end;
  163. END;
  164.  
  165. PROCEDURE readfont (bufptr:pointer);
  166. VAR
  167.   numberofentries : BYTE;
  168.   i, j, k : BYTE;
  169.   begchar, endchar : BYTE;
  170.   segbuf, ofsbuf : WORD;
  171. BEGIN
  172. if EGA then begin
  173.   segbuf := SEG (bufptr^);
  174.   ofsbuf := OFS (bufptr^);
  175. MOVE(mem[segbuf:ofsbuf],mem[seg(fontheaderstring):ofs(fontheaderstring)+1],7);
  176.  mem[seg(fontheaderstring):ofs(fontheaderstring)]:=7;
  177.   ofsbuf := ofsbuf + 7;
  178.   IF fontheaderstring = fontheader THEN
  179.      BEGIN
  180.      setscanlines (mem [segbuf : ofsbuf]);
  181.      INC (ofsbuf);
  182.      linesperchar := mem [segbuf : ofsbuf];
  183.      INC (ofsbuf);
  184.      setlinesperchar;
  185.      IF (linesperchar < 16) THEN
  186.         BEGIN
  187.         numberofentries := mem [segbuf : ofsbuf];
  188.         INC (ofsbuf);
  189.         FOR i := 0 TO numberofentries DO
  190.             BEGIN
  191.             begchar := mem [segbuf : ofsbuf];
  192.             INC (ofsbuf);
  193.             endchar := mem [segbuf : ofsbuf];
  194.             INC (ofsbuf);
  195.             FOR j := begchar TO endchar DO
  196.                 BEGIN
  197.                 sequencefonts;
  198.                 MOVE (mem[segbuf:ofsbuf],mem[$a000:32 * j], linesperchar + 1);
  199.                 desequencefonts;
  200.                 ofsbuf := ofsbuf + linesperchar + 1;
  201.                 END;
  202.             END;
  203.         END;
  204.      END;
  205.   END;
  206. END;
  207.  
  208. PROCEDURE readscreen (bufptr:pointer);
  209. VAR
  210.   xy,xx : BYTE;
  211.   x1, y1, x2, y2 : BYTE;
  212.   segbuf, ofsbuf, offset : WORD;
  213.   statport : word;
  214. BEGIN
  215.   segbuf := SEG (bufptr^);
  216.   ofsbuf := OFS (bufptr^);
  217.   x1 := mem [segbuf : ofsbuf];
  218.   y1 := mem [segbuf : ofsbuf + 1];
  219.   x2 := mem [segbuf : ofsbuf + 2];
  220.   y2 := mem [segbuf : ofsbuf + 3];
  221.   ofsbuf := ofsbuf + 4;
  222.   IF x1 > x2 THEN
  223.      BEGIN xy := x1;x1 := x2;x2 := xy;END;
  224.   IF y1 > y2 THEN BEGIN
  225.      xy := y1;y1 := y2;y2 := xy;END;
  226. if vseg=$b800 then statport:=$3d4 else statport:=$3b4;
  227. if ega then FOR xy := y1 TO y2 DO
  228.       BEGIN
  229.       MOVE (mem [segbuf : ofsbuf], mem [vseg : 2 * ( ( (xy - 1) * 80) + (x1 - 1) ) ], 2 * ( (x2 + 1) - x1) );
  230.       ofsbuf := ofsbuf + (2 * ( (x2 + 1) - x1) );
  231.       END else for xy:=y1 to y2 do begin
  232.        for xx:=x1 to x2 do begin
  233.         offset:=(((xy-1)*80)+(xx-1))*2;
  234.        repeat until port[statport]<>1;
  235.         memw[$b800:offset]:=memw[segbuf:ofsbuf];
  236.        inc(ofsbuf,2);end;
  237.       end;
  238. END;
  239.  
  240.  
  241. PROCEDURE EGA_Grfx (a, b : BYTE);
  242. BEGIN
  243.   port [$3ce] := a;
  244.   port [$3cf] := b;
  245. END;
  246.  
  247. PROCEDURE detEGA;
  248. CONST TestMask : BYTE = 1;
  249. VAR Regs : REGISTERS;
  250.   BIOSbyte : BYTE;
  251. BEGIN
  252.   IF (mem [0 : $410] AND 48) = 48 THEN
  253.      vseg := $b000 ELSE
  254.      vseg := $b800;
  255.   BIOSbyte := mem [ $40 : $87 ];
  256.   Regs.AH := $12;
  257.   Regs.BL := $10;
  258.   Regs.BH := $FF;
  259.   INTR ( $10, Regs );
  260.   IF (Regs.BL <> (BIOSbyte AND $60) SHR 5) AND
  261.    (Regs.BH <> (BIOSbyte AND $02 ) SHR 1 ) AND
  262.      ( Regs.BH = $FF ) THEN
  263.      BEGIN EGA := FALSE; EXIT; END;
  264.   EGA_Grfx ( 8, TestMask );
  265.   port [ $3CE ] := 8;
  266.   IF port [ $3CF ] = TestMask THEN
  267.      VGA := TRUE;
  268.   EGA_Grfx ( 8, $FF );
  269.   EGA := TRUE;
  270. END;
  271.  
  272. procedure savefonts (var buffer:fontsavetype);
  273. begin
  274.   sequencefonts;
  275.   move( mem [ $a000 : 0 ], buffer , 8192 );
  276.   desequencefonts;
  277. end;
  278.  
  279. procedure restorefonts (var buffer:fontsavetype);
  280. begin
  281.   sequencefonts;
  282.   move( buffer , mem [ $a000 : 0 ] , 8192 );
  283.   desequencefonts;
  284. end;
  285.  
  286. procedure resetfonts;
  287. begin
  288. inline( $b8 / $83 / 0 / $cd / $10 );
  289. if vga then setscanlines(2);
  290. end;
  291.  
  292. BEGIN
  293. detEGA;
  294. END.